home *** CD-ROM | disk | FTP | other *** search
/ Programming Languages Suite / ProgramD2.iso / Borland / Borland C++ V5.02 / DLLMIX.PAK / MAIN.PAS < prev    next >
Pascal/Delphi Source File  |  1997-05-06  |  5KB  |  173 lines
  1. //----------------------------------------------------------------------------
  2. // Mixing BC++ built 32-bit DLL's with non-BC applications.
  3. // Copyright (c) 1996 by Borland International, All Rights Reserved
  4. //----------------------------------------------------------------------------
  5. unit main;
  6.  
  7. interface
  8.  
  9. uses
  10.    Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  11.    ExtCtrls, StdCtrls, Menus;
  12.  
  13. type
  14.    { Function types }
  15.    TbcMessage = function (msg: pchar) : Longint; stdcall;
  16.    TbcMultiply =   function (m1: Smallint; m2: Longint) : Longint; cdecl;
  17.    TbcAverage = function (d: Double; f: Single) : Extended; stdcall;
  18.    TCdeclVoidFunc = procedure cdecl;
  19.    TStdCallVoidFunc = procedure stdcall;
  20.  
  21.    TDelphiToBC = class(TForm)
  22.       BtnMessage: TButton;
  23.       BtnMultiply: TButton;
  24.       BtnAverage: TButton;
  25.       BtnExceptionTest: TButton;
  26.       BtnUnhandledException: TButton;
  27.       Image1: TImage;
  28.       CancelBtn: TButton;
  29.  
  30.       procedure FormCreate(Sender: TObject);
  31.       procedure FormClose(Sender: TObject; var Action: TCloseAction);
  32.       procedure BtnMessageClick(Sender: TObject);
  33.       procedure BtnMultiplyClick(Sender: TObject);
  34.       procedure BtnAverageClick(Sender: TObject);
  35.       procedure BtnExceptionTestClick(Sender: TObject);
  36.       procedure BtnUnhandledExceptionTestClick(Sender: TObject);
  37.     procedure CancelBtnClick(Sender: TObject);
  38.    private
  39.       { Private declarations }
  40.       hCDll           :Longint;
  41.       bcMessage       :TbcMessage;
  42.       bcMultiply      :TbcMultiply;
  43.       bcAverage       :TbcAverage;
  44.       bcExceptionTest :TCdeclVoidFunc;
  45.       bcUnhandledTest :TStdCallVoidFunc;
  46.       procedure NoDLL;
  47.    public
  48.       { Public declarations }
  49.    end;
  50.  
  51. var
  52.    DelphiToBC      :TDelphiToBC;
  53.  
  54. implementation
  55.  
  56. {$R *.DFM}
  57.  
  58. procedure TDelphiToBC.FormCreate(Sender: TObject);
  59. begin
  60.    hCDll := LoadLibrary('BCDLL');
  61.    if hCDll <= HINSTANCE_ERROR then
  62.       begin
  63.          ShowMessage('LoadLibrary failure');
  64.          hCDll := NULL;
  65.       end
  66.    else
  67.       begin
  68.          { GetProcAddress expects an exact, case-sensitive match }
  69.          { So, we must add addornments for Cdecl and force upper case for PASCAL }
  70.          bcMessage       := GetProcAddress(hCDll, 'Message');
  71.          bcMultiply      := GetProcAddress(hCDll, '_Multiply');
  72.          bcAverage       := GetProcAddress(hCDll, 'Average');
  73.          bcExceptionTest := GetProcAddress(hCDll, '_ExceptionTest');
  74.          bcUnhandledTest := GetProcAddress(hCDll, 'UnhandledException');
  75.       end;
  76. end;
  77.  
  78. procedure TDelphiToBC.FormClose(Sender: TObject; var Action: TCloseAction);
  79. begin
  80.    if not hCDll = NULL then
  81.    begin
  82.       FreeLibrary(hCDll);
  83.       hCdll := NULL;
  84.    end;
  85. end;
  86.  
  87. procedure TDelphiToBC.NoDLL();
  88. begin
  89.    ShowMessage('Function not hooked up. DLL loaded?');
  90. end;
  91.  
  92. procedure TDelphiToBC.BtnMessageClick(Sender: TObject);
  93. begin
  94.    if not Assigned (bcMessage) then
  95.       begin
  96.          NoDLL;
  97.          exit;
  98.       end;
  99.    bcMessage('A message from Delphi');
  100. end;
  101.  
  102. procedure TDelphiToBC.BtnMultiplyClick(Sender: TObject);
  103. var
  104.    si    : Smallint;
  105.    li    : Longint;
  106.    ans   : Longint;
  107.    str   : string[40];
  108. begin
  109.    if not Assigned (bcMultiply) then
  110.       begin
  111.          NoDLL;
  112.          exit;
  113.       end;
  114.    si := 55;
  115.    li := -1024;
  116.    ans := bcMultiply(si, li);
  117.    str := IntToStr(si) + ' * ' + IntToStr(li) + ' = ' + IntToStr(ans);
  118.    ShowMessage(str);
  119. end;
  120.  
  121. {   TbcAverage = function (d: Double; f: Single) : Extended; stdcall; }
  122. procedure TDelphiToBC.BtnAverageClick(Sender: TObject);
  123. var
  124.    dbl   : Double;
  125.    sngl  : Single;
  126.    ans   : Extended;
  127.    str   : string;
  128. begin
  129.    if not Assigned (bcAverage) then
  130.       begin
  131.          NoDLL;
  132.          exit;
  133.       end;
  134.    dbl := 6232.001;
  135.    sngl := 128.327;
  136.    ans := bcAverage(dbl, sngl);
  137.    str := 'The average of ' + string(Variant(dbl)) + ' and ' + string(Variant(sngl))
  138.          + ' is ' + string(Variant(ans));
  139.    ShowMessage(str);
  140. end;
  141.  
  142. procedure TDelphiToBC.BtnExceptionTestClick(Sender: TObject);
  143. begin
  144.    if not Assigned (bcExceptionTest) then
  145.       begin
  146.          NoDLL;
  147.          exit;
  148.       end;
  149.    bcExceptionTest;
  150. end;
  151.  
  152. procedure TDelphiToBC.BtnUnhandledExceptionTestClick(Sender: TObject);
  153. begin
  154.    if not Assigned (bcUnhandledTest) then
  155.       begin
  156.          NoDLL;
  157.          exit;
  158.       end;
  159.    try
  160.       bcUnhandledTest;
  161.    except
  162.       ShowMessage('Application caught exception thrown from a Borland C++ DLL');
  163.    end;
  164.  
  165. end;
  166.  
  167. procedure TDelphiToBC.CancelBtnClick(Sender: TObject);
  168. begin
  169.    application.terminate();
  170. end;
  171.  
  172. end.
  173.